library('lubridate')


olddf=read.csv(file="/Files for R/ReSTAT/Permu_ReSTAT.csv")

# define number of repetitions
repet=1000

#build a dataset with the prsk pch and rec_in
fakedata_risk=matrix(rep(NaN,(length(olddf$rec_in)*repet)),length(olddf$rec_in),repet)
fakedata_ch=matrix(rep(NaN,(length(olddf$rec_in)*repet)),length(olddf$rec_in),repet)
fakedata_rec_in=matrix(rep(NaN,(length(olddf$rec_in)*repet)),length(olddf$rec_in),repet)

fakedata_risk<-data.frame(fakedata_risk)
fakedata_risk$numzzperm<-df$numzzperm
fakedata_ch<-data.frame(fakedata_ch)
fakedata_ch$numzzperm<-df$numzzperm
fakedata_rec_in<-data.frame(fakedata_rec_in)
fakedata_rec_in$numzzperm<-df$numzzperm
                   
##################################
###  Begin Here
##################################
##### p==254
#need to be certain the dataset (oldf) is sorted by labelfac912
system.time(
  for (p in 254:repet){
    print(p)
df=olddf
df$rec_in<-unlist(tapply(olddf$rec_in, olddf$labelfac912,function(x) 
  sample(x,length(x),replace=F)),use.names=FALSE)
df$rec_in=as.Date(df$rec_in, format='%d %b %y')
df$rec_out=df$rec_in+df$los2
Peerz=df[c('rec_in','rec_out','labelfac91', 'los2','numzzperm')]

##################################
### Build the peer matrix #########
###################################
# first generate an NxN matrix of null values 
permumatrix=matrix(0,length(Peerz$rec_out),length(Peerz$rec_out))

#Add a column to organize the 
Peerz=transform(Peerz,share=0, lastin=0, firstout=0)

   #Build peer measuPeerz

for (k in 1:length(Peerz$numzzperm)){
  if (k==1000 |k==5000|k==10000|k==15000|k==20000|k==25000|k==length(olddf$rec_int)){print(k)}
  #make the subset
  samefacility=subset(Peerz, with(Peerz,labelfac91==labelfac91[k] & rec_in<=rec_out[k] & rec_out>=rec_in[k]))
  #build the time shared variable (is there a quicker way?)
  samefacility$firstout=ifelse(samefacility$rec_out<Peerz$rec_out[k], samefacility$rec_out, Peerz$rec_out[k])
  samefacility$lastin  =ifelse(samefacility$rec_in >Peerz$rec_in[k],  samefacility$rec_in,  Peerz$rec_in[k])
  samefacility$share=samefacility$firstout-samefacility$lastin
  #adding values to the peer matrix
  for(j in 1:length(samefacility$numzzperm)){
    permumatrix[k,samefacility$numzzperm[j]]=samefacility$share[j]
    permumatrix[k,k]=0
  }
  rm(samefacility)
}

# ignore if missing
permumatrix[,is.na(df$rskscr)]=0

# replace missing values with zeros
df$chscr[is.na(df$chscr)]=0
df$rskscr[is.na(df$rskscr)]=0

ones=rep(1,length(Peerz$numzzperm))
totday=permumatrix%*%ones

# build peer scores 
df$prsk=permumatrix %*% df$rskscr /totday
df$pch=permumatrix %*% df$chscr /totday


fakedata_risk[,p]=df$prsk
fakedata_ch[,p]=df$pch
fakedata_rec_in[,p]=df$rec_in

if(p==50|p==100|p==200|p==300|p==400|p==500|p==600|p==700|p==800|p==900|p==1000){
  write.dta(fakedata_risk, file="/Files for R/ReSTAT/fakedata_risk.dta")
  write.dta(fakedata_ch, file="/Files for R/ReSTAT/fakedata_ch.dta")
  write.dta(fakedata_rec_in, file="/Files for R/ReSTAT/fakedata_rec_in.dta")
}
  }
)


